unit uGerber ;

interface

uses
    SysUtils,
    Classes,
    ActnList,
    uBasic,
    uObjects,
    uPlacement,
    uViewPCB,
    uVisitor,
    GDIPAPI ;

type

    TGerberMoveMode = ( gmmOff, gmmOn, gmmFlash ) ;
    TGerberState = ( gsAperture, gsDraw ) ;
    TGAType = ( gaRect, gaRound, gaThermal, gaOcto, gaOblong ) ;
    TGerberAperture = record
        case aType : TGAType of
            gaOblong, gaRect : ( aWidth, aHeight : single ) ;
            gaRound : ( aDiam : single ) ;
    end ;

    TToGerberVisitor = class( TMedaVisitor )
    private
        fStream : TFileStream ;
        fCurX, fCurY : integer ;
        fState : TGerberState ;
        fApertures : array of TGerberAperture ;
        fCurrentAperture : integer ;

        procedure ResetApertures ;
        procedure AddAperture( aType : TGAType ; aData : array of single ) ;

        procedure WriteLine( aString : string ) ;
        procedure WriteFormat( const aFmt : string ; const aData : array of const ) ;
        procedure WriteEOR ;
        procedure WriteHeader( aProjectName, aFilename : string ; aLayerType : TMedaLayerType ) ;
        procedure WriteAperture( aAperture : integer ) ;
        procedure WriteApertures ;
        procedure WriteFooter ;

        procedure WriteX( aValue : integer ) ;
        procedure WriteY( aValue : integer ) ;
        procedure Move( aPoint : TGPPoint ; aMode : TGerberMoveMode ) ;
    public
        function VisitNode( Instance : TMedaViewable ) : TObject ; override ;

        // views
        function VisitNode( Instance : TMSPOutline ) : TObject ; override ;
        function VisitNode( Instance : TMSPShape ) : TObject ; override ;
        function VisitNode( Instance : TMSPTrack ) : TObject ; override ;
        function VisitNode( Instance : TMSPLabel ) : TObject ; override ;
        function VisitNode( Instance : TMSPPad ) : TObject ; override ;
        function VisitNode( Instance : TMSPPadOcta ) : TObject ; override ;
        function VisitNode( Instance : TMSPPadCircle ) : TObject ; override ;
        function VisitNode( Instance : TMSPPadOblong ) : TObject ; override ;
        function VisitNode( Instance : TMSPPadRect ) : TObject ; override ;

        // viewers
        function VisitNode( Instance : TMedaPCBLayer ) : TObject ; override ;
        function VisitNode( Instance : TMedaPCBInterface ) : TObject ; override ;

        procedure SaveToFile( aPCB : TMedaPCBInterface ; aLayerSet : TMedaLayerSet ; aFilename : string ) ;
    end ;

    TdmGerber = class( TDataModule )
        ActionList : TActionList ;
        actGerber : TAction ;
        procedure actGerberExecute( Sender : TObject ) ;
        procedure actGerberUpdate( Sender : TObject ) ;
    private
        { Private declarations }
    public
        { Public declarations }
    end ;

var
    dmGerber        : TdmGerber ;

implementation

{$R *.dfm}

uses
    uMain,
    uProject ;

{ TToGerberVisitor }

procedure TdmGerber.actGerberExecute( Sender : TObject ) ;
begin
    with TToGerberVisitor.Create do try
        SaveToFile( vsbPCBViewer.ProjectView, CopperLayerSet, dmProject.Project.Name ) ;
    finally
        Free ;
    end ;
end ;

procedure TdmGerber.actGerberUpdate( Sender : TObject ) ;
begin
    ( Sender as TAction ).Enabled := vsbPCBViewer.ProjectView.GetChildCount > 0 ;
end ;

procedure TToGerberVisitor.SaveToFile( aPCB : TMedaPCBInterface ; aLayerSet : TMedaLayerSet ; aFilename : string ) ;
const
    cGerberExtension : array[ TMedaLayerType ] of string = (
        'mch', 'top', 'bot', 'gnd', 'pwr', 'in0', 'in1', 'in2', 'in3', 'tpp', 'tps', 'bts', 'btp'
        ) ;
var
    layer           : TMedaLayerType ;
    iFilename       : string ;
begin
    if aFilename <> '' then
        for layer := low( TMedaLayerType ) to high( TMedaLayerType ) do
            if layer in aLayerSet then begin
                iFilename := aFilename + '.' + cGerberExtension[ layer ] ;
                fStream := TFileStream.Create( iFilename, fmCreate ) ;
                try
                    fCurX := 0 ;
                    fCurY := 0 ;
                    WriteHeader( aFilename, iFilename, layer ) ;
                    fState := gsAperture ;
                    fApertures := nil ;
                    aPCB.GetChild( ord( layer ) ).Accept( Self ) ;
                    WriteApertures ;
                    fCurrentAperture := -1 ;
                    fState := gsDraw ;
                    aPCB.GetChild( ord( layer ) ).Accept( Self ) ;
                    WriteFooter ;
                finally
                    fStream.Free ;
                end ;
            end ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMSPShape ) : TObject ;
begin
    Result := VisitNode( TMedaViewable( Instance ) ) ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMSPPadRect ) : TObject ;
begin
    if fState = gsAperture then begin
        //        AddAperture( gaRect, [ Instance.Size.Width, Instance.Size.Height ] ) ;
    end
    else begin
        WriteAperture( ( Instance as TMedaView ).Aperture ) ;
        //        Move( Instance.Position, gmmFlash ) ;
    end ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMSPPadOblong ) : TObject ;
begin
    if fState = gsAperture then begin
        //        AddAperture( gaOblong, [ Instance.Size.Width, Instance.Size.Height ] ) ;
    end
    else begin
        WriteAperture( ( Instance as TMedaView ).Aperture ) ;
        //        Move( Instance.Position, gmmFlash ) ;
    end ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMSPPad ) : TObject ;
begin

end ;

function TToGerberVisitor.VisitNode( Instance : TMSPPadCircle ) : TObject ;
begin
    if fState = gsAperture then begin
        //        AddAperture( gaRound, [ Instance.OD ] ) ;
    end
    else begin
        WriteAperture( ( Instance as TMedaView ).Aperture ) ;
        //        Move( Instance.Position, gmmFlash ) ;
    end ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMSPPadOcta ) : TObject ;
begin

end ;

function TToGerberVisitor.VisitNode( Instance : TMSPTrack ) : TObject ;
begin

end ;

function TToGerberVisitor.VisitNode( Instance : TMedaViewable ) : TObject ;
var
    i               : integer ;
begin
    with Instance do
        for i := 0 to GetChildCount - 1 do begin
            Result := GetChild( i ) ;
            if assigned( Result ) then
                Result := TMedaViewable( Result ).Accept( Self ) ;
        end ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMSPOutline ) : TObject ;
begin

end ;

function TToGerberVisitor.VisitNode( Instance : TMSPLabel ) : TObject ;
begin

end ;

function TToGerberVisitor.VisitNode( Instance : TMedaPCBLayer ) : TObject ;
begin
    Result := VisitNode( TMedaViewable( Instance ) ) ;
end ;

function TToGerberVisitor.VisitNode( Instance : TMedaPCBInterface ) : TObject ;
begin
    Result := VisitNode( TMedaViewable( Instance ) ) ;
end ;

procedure TToGerberVisitor.WriteEOR ;
begin
    WriteLine( '*' ) ;
end ;

procedure TToGerberVisitor.WriteHeader( aProjectName, aFilename : string ; aLayerType : TMedaLayerType ) ;
begin
    WriteLine( 'G04 ObjectEDA V0.00 *' ) ;
    WriteFormat( 'G04 Date: %s *', [ FormatDateTime( 'dd mmmm yyyy, hh:nn:ss.zzz', Now ) ] ) ;
    WriteFormat( 'G04 Project name: %s *', [ aProjectName ] ) ;
    WriteFormat( 'G04 File name: %s *', [ aFilename ] ) ;
    WriteFormat( 'G04 Layer name: %s *', [ GetPCBLayerName( aLayerType ) ] ) ;
    WriteLine( '*' ) ;

    WriteFormat( '%%LN%s*%%', [ GetPCBLayerName( aLayerType ) ] ) ;
    WriteLine( '%LPD*%' ) ;
    WriteLine( '*' ) ;

    WriteLine( '%FSLAX34Y34*MOIN*%' ) ;
    WriteLine( '%SFA1.000B1.000*%' ) ;
    WriteLine( '%MIA0B0*%' ) ;
    WriteLine( '%IPPOS*%' ) ;
    WriteLine( '*' ) ;

    WriteLine( 'G01*' ) ;
    WriteLine( 'G90*' ) ;
    WriteLine( 'G74*' ) ;
    WriteLine( '*' ) ;
end ;

{
%ASAXBY*
FSLAX23Y23*
MIB1*
MOIN*
OFA0B0*
%OFA1.0B1.0*%
SFA1.0B1.0*%
%IJALBL*
INXTEST*
IOA0B0*
IOA-2.0B3.2*
IPPOS*
IPNEG*
IR0*%
PFMYPLOTFILM*
G04 Define Apertures*
%AMTARGET125*
6,0,0,0.125,.01,0.01,3,0.003,0.150,0*%
%AMTHERMAL80*
7,0,0,0.080,0.055,0.0125,45*%
%ADD10C,0.01*
ADD11C,0.06*
ADD12R,0.06X0.06*
ADD13R,0.04X0.100*
ADD14R,0.100X0.04*
ADD15O,0.04X0.100*
ADD16P,0.100X3*
ADD17P,0.100X3*
ADD18TARGET125*
ADD19THERMAL80*%
%LNXTEST1*
LPD*
SRX4I0.5J5.0*%
G54D10*
G01X0Y250D02*
X0Y0D01*
X250Y0D01*
X1000Y1000D02*
X1500D01*
X2000Y1500*
X2500D02*
Y1000D01*
D02*
G54D11*
G55X1000Y1000D03*
X2000D03*
}

procedure TToGerberVisitor.WriteAperture( aAperture : integer ) ;
begin
    if aAperture <> fCurrentAperture then begin
        WriteFormat( '%%G54D%d*', [ aAperture + 10 ] ) ;
        fCurrentAperture := aAperture ;
    end ;
end ;

{
%ADD10C,0.01*
ADD11C,0.06*
ADD12R,0.06X0.06*
ADD13R,0.04X0.100*
ADD14R,0.100X0.04*
ADD15O,0.04X0.100*
ADD16P,0.100X3*
ADD17P,0.100X3*
ADD18TARGET125*
ADD19THERMAL80*%

%ADD21C,.100*%                        (A) 0.10 diameter circle on d21

%ADD22C,.100X.050*%                   (B) 0.10 dia circle with 0.05 hole on d22.

%ADD23C,.100X.050X.050*%              (C) 0.10 dia circle with 0.05 square hole on d23

%ADD24C,.100X.050X.025*%              (D) 0.10 dia circle with 0.05 x 0.025 rectangular hole on d24}

procedure TToGerberVisitor.WriteApertures ;
var
    i               : integer ;
begin
    for i := 0 to length( fApertures ) - 1 do
        with fApertures[ i ] do
            case aType of
                gaRect : WriteFormat( '%%ADD%dR,%dX%d*%%', [ i + 10, aWidth, aHeight ] ) ;
                gaOblong : WriteFormat( '%%ADD%dO,%dX%d*%%', [ i + 10, aWidth, aHeight ] ) ;
                gaRound : WriteFormat( '%%ADD%dR,%dX%d*%%', [ i + 10, aWidth, aHeight ] ) ;
                gaOcto : WriteFormat( '%%ADD%dR,%dX%d*%%', [ i + 10, aWidth, aHeight ] ) ;
                gaThermal : WriteFormat( '%%ADD%dO,%dX%d*%%', [ i + 10, aWidth, aHeight ] ) ;
            end ;
end ;

procedure TToGerberVisitor.WriteFooter ;
begin
    WriteLine( 'M02*' ) ;
end ;

procedure TToGerberVisitor.WriteFormat( const aFmt : string ; const aData : array of const ) ;
begin
    WriteLine( Format( aFmt, aData ) ) ;
end ;

procedure TToGerberVisitor.WriteLine( aString : string ) ;
var
    l               : integer ;
begin
    aString := aString + #13#10 ;
    l := length( aString ) ;
    if l > 0 then
        fStream.Write( aString[ 1 ], l ) ;
end ;

procedure TToGerberVisitor.Move( aPoint : TGPPoint ; aMode : TGerberMoveMode ) ;
begin
    case aMode of
        gmmOn : begin
                WriteX( aPoint.X ) ;
                WriteY( aPoint.Y ) ;
                WriteLine( 'D01' ) ;
            end ;
        gmmOff : begin
                WriteX( aPoint.X ) ;
                WriteY( aPoint.Y ) ;
                WriteLine( 'D02' ) ;
            end ;
        gmmFlash : begin
                WriteX( aPoint.X ) ;
                WriteY( aPoint.Y ) ;
                WriteLine( 'D03' ) ;
            end ;
    end ;
    WriteEOR ;
end ;

procedure TToGerberVisitor.WriteX( aValue : integer ) ;
begin
    if aValue <> fCurX then begin
        WriteFormat( 'X%.5d', [ aValue ] ) ;
        fCurX := aValue ;
    end ;
end ;

procedure TToGerberVisitor.WriteY( aValue : integer ) ;
begin
    if aValue <> fCurY then begin
        WriteFormat( 'Y%.5d', [ aValue ] ) ;
        fCurY := aValue ;
    end ;
end ;

procedure TToGerberVisitor.AddAperture( aType : TGAType ; aData : array of single ) ;
var
    l               : integer ;
begin
    l := length( fApertures ) ;
    SetLength( fApertures, l + 1 ) ;
    fApertures[ l ].aType := aType ;
    case aType of
        gaRect, gaOblong : begin
                fApertures[ l ].aWidth := aData[ 0 ] ;
                fApertures[ l ].aHeight := aData[ 1 ] ;
            end ;
        gaRound : fApertures[ l ].aDiam := aData[ 0 ] ;
    end ;
end ;

procedure TToGerberVisitor.ResetApertures ;
begin

end ;

initialization
    dmGerber := TdmGerber.Create( nil ) ;

finalization
    dmGerber.Free ;

end.

